home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / langs / xlisp2.1 / xldist02.zoo / sources / xldbug.c < prev    next >
Encoding:
C/C++ Source or Header  |  1990-11-09  |  4.1 KB  |  215 lines
  1. /* xldebug - xlisp debugging support */
  2. /*        Copyright (c) 1985, by David Michael Betz
  3.         All Rights Reserved
  4.         Permission is granted for unrestricted non-commercial use        */
  5.  
  6. #include "xlisp.h"
  7.  
  8. /* external variables */
  9. extern int xldebug;
  10. extern int xlsample;
  11. extern LVAL s_debugio,s_unbound;
  12. extern LVAL s_tracenable,s_tlimit,s_breakenable;
  13. extern LVAL true;
  14. extern char buf[];
  15.  
  16. /* forward declarations */
  17. #ifdef ANSI
  18. void breakloop(char *hdr, char *cmsg, char *emsg, LVAL arg,  int cflag);
  19. #else
  20. FORWARD VOID breakloop();
  21. #endif
  22.  
  23.  
  24. /* xlabort - xlisp serious error handler */
  25. VOID xlabort(emsg)
  26.   char *emsg;
  27. {
  28.     xlsignal(emsg,s_unbound);
  29.     xlerrprint("error",NULL,emsg,s_unbound);
  30.     xlbrklevel();
  31. }
  32.  
  33. /* xlbreak - enter a break loop */
  34. VOID xlbreak(emsg,arg)
  35.   char *emsg; LVAL arg;
  36. {
  37.     breakloop("break","return from BREAK",emsg,arg,TRUE);
  38. }
  39.  
  40. /* xlfail - xlisp error handler */
  41. VOID xlfail(emsg)
  42.   char *emsg;
  43. {
  44.     xlerror(emsg,s_unbound);
  45. }
  46.  
  47. /* xlerror - handle a fatal error */
  48. LVAL xlerror(emsg,arg)
  49.   char *emsg; LVAL arg;
  50. {
  51.     if (getvalue(s_breakenable) != NIL)
  52.         breakloop("error",NULL,emsg,arg,FALSE);
  53.     else {
  54.         xlsignal(emsg,arg);
  55.         xlerrprint("error",NULL,emsg,arg);
  56.         xlbrklevel();
  57.     }
  58.         return NIL;        /* actually doesn't return */
  59. }
  60.  
  61. /* xlcerror - handle a recoverable error */
  62. VOID xlcerror(cmsg,emsg,arg)
  63.   char *cmsg,*emsg; LVAL arg;
  64. {
  65.     if (getvalue(s_breakenable) != NIL)
  66.         breakloop("error",cmsg,emsg,arg,TRUE);
  67.     else {
  68.         xlsignal(emsg,arg);
  69.         xlerrprint("error",NULL,emsg,arg);
  70.         xlbrklevel();
  71.     }
  72. }
  73.  
  74. /* xlerrprint - print an error message */
  75. VOID xlerrprint(hdr,cmsg,emsg,arg)
  76.   char *hdr,*cmsg,*emsg; LVAL arg;
  77. {
  78.     /* print the error message */
  79.     sprintf(buf,"%s: %s",hdr,emsg);
  80.     errputstr(buf);
  81.  
  82.     /* print the argument */
  83.     if (arg != s_unbound) {
  84.         errputstr(" - ");
  85.         errprint(arg);
  86.     }
  87.  
  88.     /* no argument, just end the line */
  89.     else
  90.         errputstr("\n");
  91.  
  92.     /* print the continuation message */
  93.     if (cmsg) {
  94.         sprintf(buf,"if continued: %s\n",cmsg);
  95.         errputstr(buf);
  96.     }
  97. }
  98.  
  99. #ifdef MSC6
  100. /* no optimization which interferes with setjmp */
  101. #pragma optimize("elg",off)
  102. #endif
  103.  
  104. /* breakloop - the debug read-eval-print loop */
  105. LOCAL VOID breakloop(hdr,cmsg,emsg,arg,cflag)
  106.   char *hdr,*cmsg,*emsg; LVAL arg; int cflag;
  107. {
  108.     LVAL expr,val;
  109.     CONTEXT cntxt;
  110.     int type;
  111.  
  112.     /* print the error message */
  113.     xlerrprint(hdr,cmsg,emsg,arg);
  114.  
  115.     /* flush the input buffer */
  116.     xlflush();
  117.  
  118.     /* do the back trace */
  119.     if (getvalue(s_tracenable)) {
  120.         val = getvalue(s_tlimit);
  121.         xlbaktrace(fixp(val) ? (int)getfixnum(val) : -1);
  122.     }
  123.  
  124.     /* protect some pointers */
  125.     xlsave1(expr);
  126.  
  127.     /* increment the debug level */
  128.     ++xldebug;
  129.  
  130.     /* debug command processing loop */
  131.     xlbegin(&cntxt,CF_BRKLEVEL|CF_CLEANUP|CF_CONTINUE,true);
  132.     for (type = 0; type == 0; ) {
  133.  
  134.         /* setup the continue trap */
  135.         if ((type = setjmp(cntxt.c_jmpbuf)) != 0)
  136.             switch (type) {
  137.             case CF_CLEANUP:
  138.                 continue;
  139.             case CF_BRKLEVEL:
  140.                 type = 0;
  141.                 break;
  142.             case CF_CONTINUE:
  143.                 if (cflag) {
  144.                     dbgputstr("[ continue from break loop ]\n");
  145.                     continue;
  146.                 }
  147.                 else xlabort("this error can't be continued");
  148.             }
  149.  
  150.         /* print a prompt */
  151.         sprintf(buf,"%d> ",xldebug);
  152.         dbgputstr(buf);
  153.  
  154.         /* read an expression and check for eof */
  155.         if (!xlread(getvalue(s_debugio),&expr)) {
  156.             type = CF_CLEANUP;
  157.             break;
  158.         }
  159.  
  160.         /* save the input expression */
  161.         xlrdsave(expr);
  162.  
  163.         /* evaluate the expression */
  164.         expr = xleval(expr);
  165.  
  166.         /* save the result */
  167.         xlevsave(expr);
  168.  
  169.         /* print it */
  170.         dbgprint(expr);
  171.     }
  172.     xlend(&cntxt);
  173.  
  174.     /* decrement the debug level */
  175.     --xldebug;
  176.  
  177.     /* restore the stack */
  178.     xlpop();
  179.  
  180.     /* check for aborting to the previous level */
  181.     if (type == CF_CLEANUP)
  182.         xlbrklevel();
  183. }
  184.  
  185. #ifdef MSC6
  186. #pragma optimize("",on)
  187. #endif
  188.  
  189. /* baktrace - do a back trace */
  190. VOID xlbaktrace(n)
  191.   int n;
  192. {
  193.     LVAL *fp,*p;
  194.     int argc;
  195.     for (fp = xlfp; (n < 0 || n--) && *fp; fp = fp - (int)getfixnum(*fp)) {
  196.         p = fp + 1;
  197.         errputstr("Function: ");
  198.         errprint(*p++);
  199.         if ((argc = (int)getfixnum(*p++)) != 0)
  200.             errputstr("Arguments:\n");
  201.         while (--argc >= 0) {
  202.             errputstr("     ");
  203.             errprint(*p++);
  204.         }
  205.     }
  206. }
  207.  
  208. /* xldinit - debug initialization routine */
  209. VOID xldinit()
  210. {
  211.     xlsample = 0;
  212.     xldebug = 0;
  213. }
  214.  
  215.